'Private Declare Function ShellExecute Lib "Shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public CoSys_AX As Double
Public CoSys_AY As Double
Public CoSys_BX As Double
Public CoSys_BY As Double
Public CoSys_Az As Double

Public Ba_Min_x As Double
Public Ba_Min_y As Double
Public Ba_Min_H As Double

Public Ba_Max_x As Double
Public Ba_Max_y As Double
Public Ba_Max_H As Double



Private Sub CommandButton1_Click()
    Dim Dia1 As Object, Strr As String, PPath As String
    Dim Datums As Variant
    Dim row As Long, RowIndex As Long, col As Long, DataCount As Long, PageIndex As Long
    Dim stageStr As String, stageStr_Min_X As String, stageStr_Min_Y As String, stageStr_Max_X As String, stageStr_Max_Y As String, stageStr_Min_H As String, stageStr_Max_H As String
    
    '定义施工坐标系
    CoSys_AX = Sheet1.Cells(4, 11)
    CoSys_AY = Sheet1.Cells(4, 13)
    CoSys_BX = Sheet1.Cells(5, 11)
    CoSys_BY = Sheet1.Cells(5, 13)
    'CoSys_Az = 270# * 3.14159265 / 180#
    
    '施工坐标前缀
    x_prefix_n = Sheet1.Cells(4, 15) '桩号负值前缀
    x_prefix_p = Sheet1.Cells(4, 16) '桩号负值前缀
    y_prefix_n = Sheet1.Cells(5, 15) '偏距负值前缀
    y_prefix_p = Sheet1.Cells(5, 16) '偏距负值前缀
    
    If Trim(x_prefix_p) = "" Then x_prefix_p = x_prefix_n '如果正前缀未设，则正负前缀取同一值
    If Trim(y_prefix_p) = "" Then y_prefix_p = y_prefix_n '如果正前缀未设，则正负前缀取同一值
    'Sheet1.Cells(4, 11) = 100
    
    If Sheet1.Cells(5, 18) = "是" Then
        yrev = -1
    Else
        yrev = 1
    End If
    
    
    Ba_Min_x = -999999#
    Ba_Min_y = -999999#
    Ba_Min_H = -999999#
    
    Ba_Max_x = -999999#
    Ba_Max_y = -999999#
    Ba_Max_H = -999999#
    
    Range("A6:I10000").Select
    Selection.ClearContents
    
    row = 0
    DataCount = 1
    Set Dia1 = Application.FileDialog(msoFileDialogFilePicker)
    Dia1.Title = "覃东 qindong@email.cn 版权所有(C) 中国水电十二局·安能一局联合体 V20251107"
    With Dia1
        .AllowMultiSelect = False '限制只能同时选择一个文件
        .Filters.Clear
        .Filters.Add "南方CASS格式", "*.dat", 1 '限制显示的文件类型
        .Show
        For Each vrtSelectedItem In .SelectedItems
            PPath = vrtSelectedItem
        Next
        
    End With
    If Trim(PPath) <> "" Then
        Open PPath For Input As #1
        Do While Not EOF(1)
            Line Input #1, Strr
            If Trim(Strr) <> "" Then
                Datums = Split(Strr, ",")
                If UBound(Datums) = 4 Then
                    CalStage Val(Datums(3)), Val(Datums(2)), Val(Datums(4)) '计算大坝坐标桩号
                    PageIndex = Int((DataCount - 1) / 86)
                    RowIndex = Int((DataCount - 1 - PageIndex * 86) / 43)
                    If RowIndex = 0 Then
                        col = 2
                    Else
                        col = 6
                    End If
                    '增加一页
                    If DataCount = PageIndex * 86 + 1 Then
                        Range("A6:I48").Select
                        Application.CutCopyMode = False
                        Selection.Copy
                        Range("A" & (PageIndex * 43 + 6)).Select
                        ActiveSheet.Paste
                        Range("A" & (PageIndex * 43 + 6) & ":" & "I" & ((PageIndex + 1) * 43 + 6 - 1)).Select
                        '添加分页符 2025-10-08 如美
                        If PageIndex > 0 Then
                            ActiveSheet.HPageBreaks.Add Before:=Selection
                        End If
                        Selection.ClearContents
                    End If
                    If (DataCount - 1) Mod 43 = 0 Then row = 0
                    Sheet1.Cells(PageIndex * 43 + 6 + row, col - 1) = DataCount
                    Sheet1.Cells(PageIndex * 43 + 6 + row, col) = Datums(3)
                    Sheet1.Cells(PageIndex * 43 + 6 + row, col + 1) = Datums(2)
                    Sheet1.Cells(PageIndex * 43 + 6 + row, col + 2) = Datums(4)
                    row = row + 1
                    DataCount = DataCount + 1
                End If
            End If
        Loop
        Close #1
        '设置打印区域
        ActiveSheet.PageSetup.PrintArea = "$A$5:$I$" & ((PageIndex + 1) * 43 + 6 - 1)
        Ba_Min_y = Ba_Min_y * yrev
        Ba_Max_y = Ba_Max_y * yrev

        
        '探测桩号范围
        If Ba_Min_x < 0 Then
            stageStr_Min_X = x_prefix_n & "0" & Format(Round(Ba_Min_x, 2), "0.0")
        Else
            stageStr_Min_X = x_prefix_p & "0+" & Format(Round(Ba_Min_x, 2), "0.0")
        End If
        
        If Ba_Max_x < 0 Then
            stageStr_Max_X = x_prefix_n & "0" & Format(Round(Ba_Max_x, 2), "0.0")
        Else
            stageStr_Max_X = x_prefix_p & "0+" & Format(Round(Ba_Max_x, 2), "0.0")
        End If
        
        If Ba_Min_y < 0 Then
            stageStr_Min_Y = y_prefix_n & "0" & Format(Round(Ba_Min_y, 2), "0.0")
        Else
            stageStr_Min_Y = y_prefix_p & "0+" & Format(Round(Ba_Min_y, 2), "0.0")
        End If
        
        If Ba_Max_y < 0 Then
            stageStr_Max_Y = y_prefix_n & "0" & Format(Round(Ba_Max_y, 2), "0.0")
        Else
            stageStr_Max_Y = y_prefix_p & "0+" & Format(Round(Ba_Max_y, 2), "0.0")
        End If
        
        stageStr_Min_H = "EL." & Format(Round(Ba_Min_H, 2), "0.0")
        stageStr_Max_H = "EL." & Format(Round(Ba_Max_H, 2), "0.0")
        
        If Ba_Min_y > 0 Then
            stageStr = "(" & stageStr_Min_X & "～" & stageStr_Max_X & "；" & stageStr_Min_Y & "～" & stageStr_Max_Y & "；" & stageStr_Min_H & "～" & stageStr_Max_H & ")"
        ElseIf Ba_Min_y < 0 And Ba_Max_y > 0 Then
            stageStr = "(" & stageStr_Min_X & "～" & stageStr_Max_X & "；" & stageStr_Max_Y & "～" & stageStr_Min_Y & "；" & stageStr_Min_H & "～" & stageStr_Max_H & ")"
        ElseIf Ba_Max_y < 0 Then
            stageStr = "(" & stageStr_Min_X & "～" & stageStr_Max_X & "；" & stageStr_Max_Y & "～" & stageStr_Min_Y & "；" & stageStr_Min_H & "～" & stageStr_Max_H & ")"
        Else
            stageStr = "(" & stageStr_Min_X & "～" & stageStr_Max_X & "；" & stageStr_Min_Y & "～" & stageStr_Max_Y & "；" & stageStr_Min_H & "～" & stageStr_Max_H & ")"
        End If
        
        Range("A3:I3").Select
        Selection.Font.Name = "宋体"
        Selection.Font.Bold = False
        Range("A3:I3").Select
        ActiveCell.FormulaR1C1 = "工程部位：" & stageStr
        With ActiveCell.Characters(Start:=1, Length:=5).Font
            .Name = "黑体"
            .FontStyle = "加粗"
            .Size = 10
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ColorIndex = xlAutomatic
        End With
        Sheet1.Cells(8, 11) = stageStr
        If Trim(Sheet1.Cells(7, 11)) = "" Then Sheet1.Cells(7, 11) = Format(Date, "yyyy-mm-dd")
        '设置日期格
        Range("H4:I4").Select
        Selection.Font.Name = "宋体"
        ActiveCell.FormulaR1C1 = "日期:" & Format(Sheet1.Cells(7, 11), "yyyy年mm月dd日")
        ActiveCell.Font.Bold = False
        With ActiveCell.Characters(Start:=1, Length:=2).Font
            .Name = "黑体"
            .FontStyle = "加粗"
            .Size = 10
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ColorIndex = xlAutomatic
        End With
        
        '设置文件名
        Sheet1.Cells(9, 11) = Format(Sheet1.Cells(7, 11), "yyyy-mm-dd") & " " & Sheet1.Cells(6, 11) & "-" & Sheet1.Cells(11, 11) & "-坐标数据表" & stageStr & ".dat"
        
        Range("A2:I2").Select
        ActiveCell.FormulaR1C1 = Trim(Sheet1.Cells(6, 11)) & Trim(Sheet1.Cells(11, 11)) & "坐标数据表"
        
        '判断文件名是否已格式化过，未格式化过则更名为格式名
        If InStr(1, Trim(PPath), "；", vbTextCompare) = 0 Then
            
            '提取路径
            part_path = Split(PPath, "/")
            f_path = Replace(PPath, part_path(UBound(part_path)), "")
            
            '更名为格式名
            If Dir(f_path & Sheet1.Cells(9, 11)) = "" Then
                Name PPath As f_path & Sheet1.Cells(9, 11)
                Sheet1.Cells(10, 11) = f_path & Sheet1.Cells(9, 11)
            Else
                Sheet1.Cells(10, 11) = "文件已存在：" & f_path & Sheet1.Cells(9, 11)
            End If
            
        End If
        
    End If
    
    
    Range("K6:K6").Select '回到顶部
    'WPS 添加分页符代码
    'ActiveSheet.HPageBreaks.Add Before:=Selection
End Sub


'计算桩号范围
Public Sub CalStage(pn As Double, pe As Double, ph As Double)
    Dim px_tmp As Double, py_tmp As Double
    px_tmp = Round((pn - CoSys_AX) * Cos(CoSys_Az) + (pe - CoSys_AY) * Sin(CoSys_Az), 3)
    py_tmp = Round(-(pn - CoSys_AX) * Sin(CoSys_Az) + (pe - CoSys_AY) * Cos(CoSys_Az), 3)
    
    If Ba_Min_x = -999999# Or px_tmp < Ba_Min_x Then Ba_Min_x = px_tmp
    If Ba_Min_y = -999999# Or py_tmp < Ba_Min_y Then Ba_Min_y = py_tmp
    If Ba_Min_H = -999999# Or ph < Ba_Min_H Then Ba_Min_H = ph
    
    If Ba_Max_x = -999999# Or px_tmp > Ba_Max_x Then Ba_Max_x = px_tmp
    If Ba_Max_y = -999999# Or py_tmp > Ba_Max_y Then Ba_Max_y = py_tmp
    If Ba_Max_H = -999999# Or ph > Ba_Max_H Then Ba_Max_H = ph
End Sub

